home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / m_to_r / pprev101 / test.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  12.8 KB  |  422 lines
  1. unit Test;
  2.  
  3.    {  *** Print Preview Tester ***  }
  4.  
  5.    { This program puts the Print Preview Component through several tests }
  6.  
  7. interface
  8.  
  9. uses
  10.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  11.   Forms, Dialogs, StdCtrls, ExtCtrls, Menus, Mask, TabNotBk, Printers,
  12.   PrntPrev;
  13.  
  14. type
  15.   TTestForm = class(TForm)
  16.     PrinterSetupDialog1: TPrinterSetupDialog;
  17.     FontDialog1: TFontDialog;
  18.     MainMenu1: TMainMenu;
  19.     File1: TMenuItem;
  20.     PrinterSetup1: TMenuItem;
  21.     N1: TMenuItem;
  22.     Exit1: TMenuItem;
  23.     PrintPreview2: TPrintPreview;
  24.     FontDialog2: TFontDialog;
  25.     TabbedNotebook1: TTabbedNotebook;
  26.     Font1But: TButton;
  27.     Preview1But: TButton;
  28.     PrintPreview1: TPrintPreview;
  29.     NumColEdit: TMaskEdit;
  30.     Label2: TLabel;
  31.     Label3: TLabel;
  32.     NumRowEdit: TMaskEdit;
  33.     Label4: TLabel;
  34.     Preview2But: TButton;
  35.     GroupBox1: TGroupBox;
  36.     Label6: TLabel;
  37.     Label7: TLabel;
  38.     Label8: TLabel;
  39.     Label9: TLabel;
  40.     LeftMar: TMaskEdit;
  41.     RightMar: TMaskEdit;
  42.     TopMar: TMaskEdit;
  43.     BotMar: TMaskEdit;
  44.     Preview3But: TButton;
  45.     Panel1: TPanel;
  46.     Button3: TButton;
  47.     Label5: TLabel;
  48.     OpenDialog1: TOpenDialog;
  49.     ScrollBox1: TScrollBox;
  50.     Image1: TImage;
  51.     PrintPreview3: TPrintPreview;
  52.     Preview4But: TButton;
  53.     Memo1: TMemo;
  54.     PrintPreview4: TPrintPreview;
  55.     Label1: TLabel;
  56.     FileMemo: TMemo;
  57.     LoadTextBut: TButton;
  58.     FontBut: TButton;
  59.     FontDialog3: TFontDialog;
  60.     OpenDialog2: TOpenDialog;
  61.     Label10: TLabel;
  62.     StartPageEdit: TMaskEdit;
  63.     PortraitBut: TRadioButton;
  64.     LandscapeBut: TRadioButton;
  65.     procedure PrintPreview1PrintPage(var Info: TPageInfo;
  66.       SCanvas: TSpecialCanvas);
  67.     procedure PrintPreview1BeginPrint(var Info: TPageInfo);
  68.     procedure PrintPreview1EndPrint(var Info: TPageInfo);
  69.     procedure Font1ButClick(Sender: TObject);
  70.     procedure Preview1ButClick(Sender: TObject);
  71.     procedure PrinterSetup1Click(Sender: TObject);
  72.     procedure Exit1Click(Sender: TObject);
  73.     procedure Preview2ButClick(Sender: TObject);
  74.     procedure PrintPreview2PrintPage(var Info: TPageInfo;
  75.       SCanvas: TSpecialCanvas);
  76.     procedure Button3Click(Sender: TObject);
  77.     procedure PrintPreview3PrintPage(var Info: TPageInfo;
  78.       SCanvas: TSpecialCanvas);
  79.     procedure Preview3ButClick(Sender: TObject);
  80.     procedure PrintPreview2BeginPrint(var Info: TPageInfo);
  81.     procedure PrintPreview3BeginPrint(var Info: TPageInfo);
  82.     procedure LoadTextButClick(Sender: TObject);
  83.     procedure FontButClick(Sender: TObject);
  84.     procedure PrintPreview4BeginPrint(var Info: TPageInfo);
  85.     procedure PrintPreview4PrintPage(var Info: TPageInfo;
  86.       SCanvas: TSpecialCanvas);
  87.     procedure Preview4ButClick(Sender: TObject);
  88.   private
  89.     { Private declarations }
  90.   public
  91.     { Public declarations }
  92.   end;
  93.  
  94. var
  95.   TestForm: TTestForm;
  96.  
  97. implementation
  98.  
  99. {$R *.DFM}
  100.  
  101. { Text Example - This example prints one page of text.  The user may
  102. select the margins }
  103.  
  104. procedure TTestForm.PrintPreview1PrintPage(var Info: TPageInfo;
  105.   SCanvas: TSpecialCanvas);
  106. var
  107.    s, s2  : string;
  108.    x,y    : integer;
  109.    my, mx : single;
  110.    i      : integer;
  111.    lmar,
  112.    rmar,
  113.    tmar,
  114.    bmar   : single;
  115. begin
  116.    lmar := StrToFloat(LeftMar.Text);
  117.    rmar := StrToFloat(RightMar.Text);
  118.    tmar := StrToFloat(TopMar.Text);
  119.    bmar := StrToFloat(BotMar.Text);
  120.  
  121.    { Only one Page, so set the LastPage flag }
  122.    Info.LastPage := True;
  123.  
  124.    s := 'This is text line number ';
  125.    SCanvas.Font := FontDialog1.Font;
  126.  
  127.    x := SCanvas.XInch(lmar);                       { Xinch returns printer units }
  128.    y := SCanvas.YInch(tmar);
  129.    my := SCanvas.PageHeight / SCanvas.Yres - bmar;
  130.    mx := SCanvas.PageWidth - SCanvas.Xinch(rmar);
  131.    i := 1;
  132.    while y+SCanvas.TextHeight(s2)<SCanvas.YInch(my) do begin
  133.       s2 := s + IntToStr(i);
  134.       while (x + SCanvas.TextWidth(s2)) > mx do
  135.          s2 := Copy(s2, 1, Length(s2)-1);
  136.       SCanvas.TextOut(x, y, s2);
  137.       y := y + SCanvas.TextHeight(s2);
  138.       i := i + 1;
  139.    end;
  140. end;
  141.  
  142. { This routine is called before each print job.  For simple print jobs,
  143. simply create a TPageInfo object and set the title.  See the Multipage
  144. example for a more complex BeginPrint routine }
  145.  
  146. procedure TTestForm.PrintPreview1BeginPrint(var Info: TPageInfo);
  147. begin
  148.    Info := TPageInfo.Create;
  149.    Info.Title := 'Text Example';
  150. end;
  151.  
  152. { This routine is used for any clean up after all pages have been
  153. printed/previewed }
  154.  
  155. procedure TTestForm.PrintPreview1EndPrint(var Info: TPageInfo);
  156. begin
  157.    Info.Free;
  158.    Info := NIL;
  159. end;
  160.  
  161. procedure TTestForm.Font1ButClick(Sender: TObject);
  162. begin
  163.    FontDialog1.Execute;
  164. end;
  165.  
  166. procedure TTestForm.Preview1ButClick(Sender: TObject);
  167. begin
  168.    PrintPreview1.PrintPreview;         { Its so easy to do Print Preview! }
  169. end;
  170.  
  171. procedure TTestForm.PrinterSetup1Click(Sender: TObject);
  172. begin
  173.    PrinterSetupDialog1.Execute;
  174. end;
  175.  
  176. procedure TTestForm.Exit1Click(Sender: TObject);
  177. begin
  178.    Close;
  179. end;
  180.  
  181. procedure TTestForm.Preview2ButClick(Sender: TObject);
  182. begin
  183.    { First set the printer orientation }
  184.    if PortraitBut.Checked then Printer.orientation := poPortrait;
  185.    if LandscapeBut.Checked then Printer.orientation := poLandscape;
  186.    PrintPreview2.PrintPreview;
  187.    Printer.Orientation := poPortrait;
  188. end;
  189.  
  190. { Table example - this example simply fills in cells with text and numbers,
  191. and draws borders around the cells.  A Thicker border is drawn around the
  192. entire table. Note the formula used below for determining pen widths }
  193.  
  194. procedure TTestForm.PrintPreview2PrintPage(var Info: TPageInfo;
  195.   SCanvas: TSpecialCanvas);
  196. var
  197.    NumRow : integer;
  198.    NumCol : integer;
  199.    x, y   : integer;
  200.    i, j   : integer;
  201.    s      : string;
  202.    dx, dy : integer;
  203.    oy, ox : integer;
  204. begin
  205.    NumCol := StrToInt(NumColEdit.Text);
  206.    NumRow := StrToInt(NumRowEdit.Text);
  207.    Info.LastPage := True;
  208.  
  209.    SCanvas.Font := FontDialog2.Font;
  210.    dx := SCanvas.TextWidth(' Cell 99, 99 X');
  211.  
  212.    { Center a Large Title }
  213.    SCanvas.Font.Size := SCanvas.Font.Size * 2;
  214.    y := SCanvas.YInch(1);
  215.    s := 'Table Example';
  216.    x := SCanvas.PageWidth div 2 - SCanvas.TextWidth(s) div 2;
  217.    SCanvas.TextOut(x,y, s);
  218.    SCanvas.Font.Size := SCanvas.Font.Size div 2;
  219.  
  220.    { Draw the Table }
  221.    SCanvas.Pen.Width := ROUND(0.5 * SCanvas.Xres / 72);     { a 0.5 point Line Width }
  222.    SCanvas.Brush.Style := bsSolid;
  223.    SCanvas.Brush.Color := clWhite;
  224.    oy := SCanvas.YInch(2);
  225.    y  := oy;
  226.    for j := 1 to NumRow do begin
  227.       ox := SCanvas.PageWidth div 2 - (dx * NumCol) div 2;
  228.       x  := ox;
  229.       dy := SCanvas.TextHeight('X');
  230.       for i := 1 to NumCol do begin
  231.          SCanvas.Rectangle(x, y, x+dx, y + dy);
  232.          s := ' Cell ' + IntToStr(i) + ', ' + IntToStr(j) + ' ';
  233.          SCanvas.TextOut(x,y, s);
  234.          x := x + dx;
  235.       end;
  236.       y := y + dy;
  237.    end;
  238.    SCanvas.Pen.Width := 2 * SCanvas.Xres div 72;     { a 3 point Line Width }
  239.    SCanvas.Brush.Style := bsClear;
  240.    SCanvas.Rectangle(ox, oy, x, y);
  241.  
  242. end;
  243.  
  244. procedure TTestForm.Button3Click(Sender: TObject);
  245. begin
  246.    if OpenDialog1.Execute then
  247.       Image1.Picture.LoadFromFile(OpenDialog1.FileName);
  248. end;
  249.  
  250. { Graphic example - This example stretches a bitmap graphic to various sizes
  251. on the page.  The display doesn't look great on a 256 color adapter, but the
  252. printed output looks on an HP4 at 600 dpi. }
  253.  
  254. procedure TTestForm.PrintPreview3PrintPage(var Info: TPageInfo;
  255.   SCanvas: TSpecialCanvas);
  256. var
  257.    R      : TRect;
  258.    w, h   : integer;
  259.    nw, nh : integer;
  260. begin
  261.    Info.LastPage := True;
  262.    with SCanvas do begin
  263.       w := Image1.Picture.Bitmap.Width;
  264.       h := Image1.Picture.Bitmap.Height;
  265.       nw := Xinch(6.5);
  266.       nh := Yinch(6.5 * h / w);
  267.       R := Rect(XInch(1), YInch(3), XInch(1)+nw, YInch(3)+nh);
  268.       StretchDraw(R, Image1.Picture.Bitmap);
  269.       Pen.Width := 2 * SCanvas.Xres div 72;     { a 3 point Line Width }
  270.       Brush.Style := bsClear;
  271.       Rectangle(XInch(1), YInch(3), XInch(1)+nw, YInch(3)+nh);
  272.  
  273.       w := Image1.Picture.Bitmap.Width;
  274.       h := Image1.Picture.Bitmap.Height;
  275.       nw := Xinch(2);
  276.       nh := Yinch(2 * h / w);
  277.       R := Rect(XInch(3.25), YInch(1), XInch(3.25)+nw, YInch(1)+nh);
  278.       StretchDraw(R, Image1.Picture.Bitmap);
  279.       Pen.Width := 2 * SCanvas.Xres div 72;     { a 3 point Line Width }
  280.       Brush.Style := bsClear;
  281.       Rectangle(XInch(3.25), YInch(1), XInch(3.25)+nw, YInch(1)+nh);
  282.    end;
  283. end;
  284.  
  285. procedure TTestForm.Preview3ButClick(Sender: TObject);
  286. begin
  287.    PrintPreview3.PrintPreview;
  288. end;
  289.  
  290. procedure TTestForm.PrintPreview2BeginPrint(var Info: TPageInfo);
  291. begin
  292.    Info := TPageInfo.Create;
  293.    Info.Title := 'Table Example';
  294. end;
  295.  
  296. procedure TTestForm.PrintPreview3BeginPrint(var Info: TPageInfo);
  297. begin
  298.    Info := TPageInfo.Create;
  299.    Info.Title := 'Graphic Example';
  300. end;
  301.  
  302. procedure TTestForm.LoadTextButClick(Sender: TObject);
  303. begin
  304.    if OpenDialog2.Execute then
  305.       FileMemo.Lines.LoadFromFile(OpenDialog2.FileName);
  306. end;
  307.  
  308. procedure TTestForm.FontButClick(Sender: TObject);
  309. begin
  310.    FontDialog3.Execute;
  311. end;
  312.  
  313. { TNEWPageInfo is used to extend TPageInfo }
  314. { You can add complex pagination information if you want }
  315.  
  316. type
  317.    TNEWPageInfo = class(TPageInfo)
  318.    public
  319.       TopLine     : array[1..999] of integer;  { Line Number at the top of each Page      }
  320.       NumPaginate : integer;                   { How many pages have been paginated       }
  321.       CanPrint    : boolean;                   { True = Printing, False = Paginating      }
  322.       OrigPage    : integer;                   { Page to print, but hasn't been paginated }
  323.    end;
  324.  
  325. procedure TTestForm.PrintPreview4BeginPrint(var Info: TPageInfo);
  326. begin
  327.    Info := TNEWPageInfo.Create;                { Use the NEW PageInfo object instead }
  328.    Info.Title := 'MultiPage example';
  329.    (Info as TNEWPageInfo).NumPaginate := 1;
  330.    (Info as TNEWPageInfo).CanPrint    := True;
  331. end;
  332.  
  333. { MultiPage example - this routine shows how to print multiple pages with
  334. EFFICIENT pagination.  Pages are only paginated when they are needed.
  335. It is a generic routine that can be applied to any pagination scheme. }
  336.  
  337. procedure TTestForm.PrintPreview4PrintPage(var Info: TPageInfo;
  338.   SCanvas: TSpecialCanvas);
  339. var
  340.    NEWInfo : TNEWPageInfo;
  341.    Line1   : integer;
  342.    x, y    : integer;
  343.    i       : integer;
  344.    s       : string;
  345. begin
  346.    NEWInfo := Info as TNEWPageInfo;
  347.  
  348.    { *** CHECK PAGINATION FIRST *** }
  349.  
  350.    { Note:  This Pagination scheme allows OUT OF ORDER print requests }
  351.    { For example, the user can print pages 15-20 without breaking the routine }
  352.    if NEWInfo.CurPage = 1 then
  353.       { No pagination needed if on the first page }
  354.       Line1 := 0                              { Memo.Lines is zero based }
  355.    else
  356.       if NEWInfo.NumPaginate >= NEWInfo.CurPage then
  357.          { Page has already been paginated }
  358.          Line1 := NEWInfo.TopLine[NEWInfo.CurPage]
  359.       else begin
  360.          { Need to do some extra pagination }
  361.          NEWInfo.CanPrint := False;
  362.          NEWInfo.OrigPage := NEWInfo.CurPage;
  363.          for i := NEWInfo.NumPaginate to NEWInfo.CurPage do begin
  364.             NEWInfo.CurPage := i;
  365.             PrintPreview4PrintPage(Info {really NEWInfo}, SCanvas);
  366.          end;
  367.          NEWInfo.CanPrint := True;
  368.          NEWInfo.CurPage := NEWInfo.OrigPage;
  369.          Line1 := NEWInfo.TopLine[NEWInfo.CurPage];
  370.       end;
  371.  
  372.    { *** ACTUAL PRINTING / PAGINATION *** }
  373.  
  374.    { Print a title line:  Title, Page, Date }
  375.    if NEWInfo.CanPrint then with SCanvas do begin
  376.       Font := FontDialog3.Font;
  377.       Font.Size  := 14;
  378.       Font.Style := Font.Style + [fsBold, fsItalic];
  379.       y := Yinch(1);
  380.       TextOut(Xinch(1), y, 'Multi-Page Example');
  381.  
  382.       s := 'Page ' + IntToStr(NEWInfo.CurPage);
  383.       TextOut(PageWidth div 2 - TextWidth(s) div 2, y, s);
  384.  
  385.       s := FormatDateTime('d mmmm yyyy', Now);
  386.       TextOut(PageWidth - Xinch(1) - TextWidth(s), y, s);
  387.    end;
  388.  
  389.    x := SCanvas.Xinch(1);
  390.    y := SCanvas.Yinch(1.5);
  391.  
  392.    SCanvas.Font := FontDialog3.Font;
  393.  
  394.    { Print out each line of text }
  395.    while (y + SCanvas.TextHeight('X') < (SCanvas.PageHeight - SCanvas.Yinch(1)))
  396.       and (Line1 <= FileMemo.Lines.Count-1) do begin
  397.       if NEWInfo.CanPrint then SCanvas.TextOut(x, y, FileMemo.Lines[Line1]);
  398.       Line1 := Line1 + 1;
  399.       y := y + SCanvas.TextHeight('X');
  400.    end;
  401.  
  402.    { Check if we're the last page }
  403.    if Line1 > FileMemo.Lines.Count-1 then begin
  404.       NEWInfo.LastPage := True;
  405.    end else
  406.       NEWInfo.LastPage := False;
  407.  
  408.    { Set some pagination variables }
  409.    NEWInfo.TopLine[NEWInfo.CurPage+1] := Line1;
  410.    if NEWInfo.NumPaginate < NEWInfo.CurPage + 1 then
  411.       NEWInfo.NumPaginate := NEWInfo.CurPage + 1;
  412. end;
  413.  
  414. procedure TTestForm.Preview4ButClick(Sender: TObject);
  415. begin
  416.    PrintPreview4.CurrentPage := StrToInt(StartPageEdit.Text);
  417.    PrintPreview4.PrintPreview;
  418. end;
  419.  
  420. end.
  421.  
  422.